home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / STAR.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  3KB  |  66 lines
  1. defdbl a-z
  2. const FALSE= 0
  3. const TRUE = NOT FALSE
  4. CONST PI = 3.141592653589#
  5.  
  6. input "Number of points:";p
  7. input "Point Top    from center:";t
  8. input "Point Bottom from center:";b
  9. input "Point Joint  from center:";j
  10. input "Thickness    from center:";th
  11. screen 1 : color 7
  12. if t>b then wy=t else wy=b
  13. if j>wy then wy=j
  14. if th>wy then wy=th
  15. wy=wy*1.1                ' allow % extra screen space
  16. wx=wy*1.5                ' adjust aspect ratio
  17. window (-wx,-wy) - (wx,wy)
  18.   open "star.dat" for output as #1
  19.   print #1,"DECLARE Star =
  20.   print #1,"  COMPOSITE
  21.   print #1,"         { p=";p;"  t=";t;"  b=";b;"  j=";j;"  th=";th;" }"
  22.   ark=2*pi/p/2
  23.   pointx=cos(-2*ark): pointy=sin(-2*ark)
  24.   a3x=pointx*b        : a3y=pointy*b    : a3z=th
  25.   c2x=cos(-ark)*j   : c2y=sin(-ark)*j    : c2z=0
  26.   pset (c2x,c2y)
  27.   for angle = 0 to (2*pi)-ark step ark*2
  28.       pointx=cos(angle): pointy=sin(angle)
  29.       a1x=pointx*t       : a1y=pointy*t      : a1z=0
  30.       line -(a1x,a1y),1
  31.       b1x=pointx*b       : b1y=pointy*b      : b1z=th
  32.       c1x=cos(angle+ark)*j : c1y=sin(angle+ark)*j : c1z=0
  33.       line -(c1x,c1y),1
  34.       c4x=0   : c4y=0    : c4z=th
  35.       gosub WritePoint
  36.       a3x=b1x : a3y=b1y : a3z=b1z
  37.       c2x=c1x : c2y=c1y : c2z=c1z
  38.   next angle
  39.   print #1,"  END_COMPOSITE
  40.   close #1
  41. while inkey$="":wend
  42. end
  43.  
  44. WritePoint:
  45.   current.point%=current.point%+1
  46.   print #1, using "       { Point #### }";current.point%
  47.  
  48.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z  ;b1x;b1y; b1z  ;c1x;c1y; c1z;
  49.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  50.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z  ;b1x;b1y; b1z  ;c2x;c2y; c2z;
  51.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  52.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a3x;a3y; a3z  ;b1x;b1y; b1z  ;c2x;c2y; c2z;
  53.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  54.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a3x;a3y; a3z  ;b1x;b1y; b1z  ;c4x;c4y; c4z;
  55.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  56.  
  57.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z  ;b1x;b1y;-b1z  ;c1x;c1y; c1z;
  58.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  59.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z  ;b1x;b1y;-b1z  ;c2x;c2y; c2z;
  60.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  61.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a3x;a3y;-a3z  ;b1x;b1y;-b1z  ;c2x;c2y; c2z;
  62.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  63.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a3x;a3y;-a3z  ;b1x;b1y;-b1z  ;c4x;c4y;-c4z;
  64.   print #1,      " END_TRIANGLE COLOUR StarCol TEXTURE StarTex END_TEXTURE END_OBJECT"
  65. return
  66.